home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacHaskell 2.2 / progs / prelude / PreludeList.hs < prev    next >
Encoding:
Text File  |  1994-09-27  |  18.8 KB  |  598 lines  |  [TEXT/YHS2]
  1. -- Standard list functions
  2.  
  3. -- build really shouldn't be exported, but what the heck.
  4. -- some of the helper functions in this file shouldn't be
  5. -- exported either!
  6.  
  7. module PreludeList (PreludeList.., foldr, build) where
  8.  
  9. import PreludePrims(build, foldr)
  10.  
  11. {-#Prelude#-}  -- Indicates definitions of compiler prelude symbols
  12.  
  13. infixl 9  !!
  14. infix  5  \\
  15. infixr 5  ++
  16. infix  4 `elem`, `notElem`
  17.  
  18.  
  19. -- These are primitives used by the deforestation stuff in the optimizer.
  20. -- the optimizer will turn references to foldr and build into
  21. -- inlineFoldr and inlineBuild, respectively, but doesn't want to
  22. -- necessarily inline all references immediately.
  23.  
  24. inlineFoldr :: (a -> b -> b) -> b -> [a] -> b
  25. inlineFoldr f z l =
  26.   let foldr' []         = z
  27.       foldr' (x:xs)    = f x (foldr' xs)
  28.   in foldr' l
  29. {-# inlineFoldr :: AlwaysInline #-}
  30.  
  31.  
  32. inlineBuild :: ((a -> [a] -> [a]) -> [b] -> [c]) -> [c]
  33. inlineBuild g           = g (:) []
  34. {-# inlineBuild :: AlwaysInline #-}
  35.  
  36.  
  37. -- head and tail extract the first element and remaining elements,
  38. -- respectively, of a list, which must be non-empty.  last and init
  39. -- are the dual functions working from the end of a finite list,
  40. -- rather than the beginning.
  41.  
  42. head            :: [a] -> a
  43. head (x:_)        =  x
  44. head []            =  error "head{PreludeList}: head []"
  45.  
  46. last            :: [a] -> a
  47. last [x]        =  x
  48. last (_:xs)        =  last xs
  49. last []            =  error "last{PreludeList}: last []"
  50.  
  51. tail            :: [a] -> [a]
  52. tail (_:xs)        =  xs
  53. tail []            =  error "tail{PreludeList}: tail []"
  54.  
  55. init            :: [a] -> [a]
  56. init [x]        =  []
  57. init (x:xs)        =  x : init xs
  58. init []            =  error "init{PreludeList}: init []"
  59.  
  60. -- null determines if a list is empty.
  61. null            :: [a] -> Bool
  62. null []            =  True
  63. null (_:_)        =  False
  64.  
  65.  
  66. -- list concatenation (right-associative)
  67.  
  68. (++)            :: [a] -> [a] -> [a]
  69. xs ++ ys        = build (\ c n -> foldr c (foldr c n ys) xs)
  70. {-# (++) :: Inline #-}
  71.  
  72.  
  73. -- the first occurrence of each element of ys in turn (if any)
  74. -- has been removed from xs.  Thus, (xs ++ ys) \\ xs == ys.
  75. (\\)            :: (Eq a) => [a] -> [a] -> [a]
  76. (\\)            =  foldl del
  77.                where [] `del` _        = []
  78.                  (x:xs) `del` y
  79.                     | x == y    = xs
  80.                     | otherwise = x : xs `del` y
  81.  
  82. -- length returns the length of a finite list as an Int; it is an instance
  83. -- of the more general genericLength, the result type of which may be
  84. -- any kind of number.
  85.  
  86. genericLength        :: (Num a) => [b] -> a
  87. genericLength l         = foldr (\ x n -> 1 + n) 0 l
  88. --genericLength []    =  0
  89. --genericLength (x:xs)    =  1 + genericLength xs
  90. {-# genericLength :: Inline #-}
  91.  
  92.  
  93. length            :: [a] -> Int
  94. length l        = foldr (\ x n -> 1 + n) 0 l
  95. --length []               = 0
  96. --length (x:xs)           = 1 + length xs
  97. {-# length :: Inline #-}
  98.  
  99. -- List index (subscript) operator, 0-origin
  100. (!!)            :: (Integral a) => [b] -> a -> b
  101. l !! i            =  nth l (fromIntegral i)
  102. {-# (!!)  :: Inline #-}
  103.  
  104. nth                     :: [b] -> Int -> b
  105. nth l m    = let f x g 0 = x
  106.           f x g i = g (i - 1)
  107.           fail _ = nthError m
  108.       in foldr f fail l m
  109.  
  110. nthError m = error ("(!!){PreludeList}: index " ++ show m ++ " out of range\n")
  111.  
  112. {-# nth  :: Inline #-}
  113. --nth _ n  | n < 0    = error "(!!){PreludeList}: negative index"
  114. --nth [] n        = error "(!!){PreludeList}: index too large"
  115. --nth (x:xs) n 
  116. --    | n == 0    = x
  117. --    | otherwise     = nth xs (n - 1)
  118. --{-# nth  :: Strictness("S,S") #-}
  119.  
  120. -- map f xs applies f to each element of xs; i.e., map f xs == [f x | x <- xs].
  121. map            :: (a -> b) -> [a] -> [b]
  122. map f xs        = build (\ c n -> foldr (\ a b -> c (f a) b) n xs)
  123. --map f []        =  []
  124. --map f (x:xs)        =  f x : map f xs
  125. {-# map  :: Inline #-}
  126.  
  127.  
  128. -- filter, applied to a predicate and a list, returns the list of those
  129. -- elements that satisfy the predicate; i.e.,
  130. -- filter p xs == [x | x <- xs, p x].
  131. filter            :: (a -> Bool) -> [a] -> [a]
  132. filter f xs        = build (\ c n ->
  133.                                   foldr (\ a b -> if f a then c a b else b)
  134.                   n xs)
  135. --filter p        =  foldr (\x xs -> if p x then x:xs else xs) []
  136. {-# filter  :: Inline #-}
  137.  
  138.  
  139. -- partition takes a predicate and a list and returns a pair of lists:
  140. -- those elements of the argument list that do and do not satisfy the
  141. -- predicate, respectively; i.e.,
  142. -- partition p xs == (filter p xs, filter (not . p) xs).
  143. partition        :: (a -> Bool) -> [a] -> ([a],[a])
  144. partition p        =  foldr select ([],[])
  145.                where select x (ts,fs) | p x          = (x:ts,fs)
  146.                           | otherwise = (ts,x:fs)
  147. {-# partition  :: Inline #-}
  148.  
  149.  
  150. -- foldl, applied to a binary operator, a starting value (typically the
  151. -- left-identity of the operator), and a list, reduces the list using
  152. -- the binary operator, from left to right:
  153. --    foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn
  154. -- foldl1 is a variant that has no starting value argument, and  thus must
  155. -- be applied to non-empty lists.  scanl is similar to foldl, but returns
  156. -- a list of successive reduced values from the left:
  157. --    scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
  158. -- Note that  last (scanl f z xs) == foldl f z xs.
  159. -- scanl1 is similar, again without the starting element:
  160. --    scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
  161.  
  162. foldl            :: (a -> b -> a) -> a -> [b] -> a
  163. foldl f z xs            = foldr (\ b g a -> g (f a b)) id xs z
  164. --foldl f z []        =  z
  165. --foldl f z (x:xs)    =  foldl f (f z x) xs
  166. {-# foldl  :: Inline #-}
  167.  
  168. foldl1            :: (a -> a -> a) -> [a] -> a
  169. foldl1 f (x:xs)        =  foldl f x xs
  170. foldl1 _ []        =  error "foldl1{PreludeList}: empty list"
  171. {-# foldl1  :: Inline #-}
  172.  
  173. scanl            :: (a -> b -> a) -> a -> [b] -> [a]
  174. scanl f q xs        =  q : (case xs of
  175.                 []   -> []
  176.                 x:xs -> scanl f (f q x) xs)
  177. {-# scanl  :: Inline #-}
  178.  
  179. scanl1            :: (a -> a -> a) -> [a] -> [a]
  180. scanl1 f (x:xs)        =  scanl f x xs
  181. scanl1 _ []        =  error "scanl1{PreludeList}: empty list"
  182. {-# scanl1 :: Inline #-}
  183.  
  184.  
  185. -- foldr, foldr1, scanr, and scanr1 are the right-to-left duals of the
  186. -- above functions.
  187.  
  188. --foldr            :: (a -> b -> b) -> b -> [a] -> b
  189. --foldr f z []        =  z
  190. --foldr f z (x:xs)    =  f x (foldr f z xs)
  191.  
  192.  
  193. foldr1            :: (a -> a -> a) -> [a] -> a
  194. foldr1 f [x]        =  x
  195. foldr1 f (x:xs)        =  f x (foldr1 f xs)
  196. foldr1 _ []        =  error "foldr1{PreludeList}: empty list"
  197. {-# foldr1  :: Inline #-}
  198.  
  199.  
  200. -- I'm not sure the build/foldr expansion wins.
  201.  
  202. scanr            :: (a -> b -> b) -> b -> [a] -> [b]
  203. --scanr f q0 l = build (\ c n ->
  204. --                        let g x qs@(q:_) = c (f x q) qs
  205. --            in foldr g (c q0 n) l)
  206. scanr f q0 []        =  [q0]
  207. scanr f q0 (x:xs)    =  f x q : qs
  208.                where qs@(q:_) = scanr f q0 xs 
  209. {-# scanr  :: Inline #-}
  210.  
  211. scanr1            :: (a -> a -> a) -> [a] -> [a]
  212. scanr1 f  [x]        =  [x]
  213. scanr1 f  (x:xs)    =  f x q : qs
  214.                where qs@(q:_) = scanr1 f xs 
  215. scanr1 _ []        =  error "scanr1{PreludeList}: empty list"
  216. {-# scanr1  :: Inline #-}
  217.  
  218.  
  219. -- iterate f x returns an infinite list of repeated applications of f to x:
  220. -- iterate f x == [x, f x, f (f x), ...]
  221. iterate            :: (a -> a) -> a -> [a]
  222. iterate f x    = build (\ c n ->
  223.                           let iterate' x' = c x' (iterate' (f x'))
  224.               in iterate' x)
  225. --iterate f x        =  x : iterate f (f x)
  226. {-# iterate  :: Inline #-}
  227.  
  228.  
  229. -- repeat x is an infinite list, with x the value of every element.
  230. repeat            :: a -> [a]
  231. repeat x        = build (\ c n -> let r = c x r in r)
  232. --repeat x        =  xs where xs = x:xs
  233. {-# repeat  :: Inline #-}
  234.  
  235. -- cycle ties a finite list into a circular one, or equivalently,
  236. -- the infinite repetition of the original list.  It is the identity
  237. -- on infinite lists.
  238.  
  239. cycle            :: [a] -> [a]
  240. cycle xs        =  xs' where xs' = xs ++ xs'
  241.  
  242.  
  243. -- take n, applied to a list xs, returns the prefix of xs of length n,
  244. -- or xs itself if n > length xs.  drop n xs returns the suffix of xs
  245. -- after the first n elements, or [] if n > length xs.  splitAt n xs
  246. -- is equivalent to (take n xs, drop n xs).
  247.  
  248. take            :: (Integral a) => a -> [b] -> [b]
  249. take n l        = takeInt (fromIntegral n) l
  250. {-# take  :: Inline #-}
  251.  
  252. takeInt                 :: Int -> [b] -> [b]
  253. takeInt m l = 
  254.   build (\ c n ->
  255.            let f x g i | i <= 0        = n
  256.                    | otherwise      = c x (g (i - 1))
  257.            in foldr f (\ _ -> n) l m)
  258. --takeInt  0     _    =  []
  259. --takeInt  _     []    =  []
  260. --takeInt  n l | n > 0    = primTake n l
  261. {-# takeInt  :: Inline #-}
  262.  
  263.  
  264.  
  265. -- Writing drop and friends in terms of build/foldr seems to lose
  266. -- way big since they cause an extra traversal of the list tail
  267. -- (except when the calls are being deforested).
  268.  
  269. drop            :: (Integral a) => a -> [b] -> [b]
  270. drop n l        = dropInt (fromIntegral n) l
  271. {-# drop  :: Inline #-}
  272. {-# drop  :: Strictness("S,S") #-}
  273.  
  274.  
  275. dropInt                 :: Int -> [b] -> [b]
  276. dropInt  0     xs    =  xs
  277. dropInt  _     []    =  []
  278. dropInt (n+1) (_:xs)    =  dropInt n xs
  279. {-# dropInt  :: Inline #-}
  280.  
  281. splitAt            :: (Integral a) => a -> [b] -> ([b],[b])
  282. splitAt n l        = splitAtInt (fromIntegral n) l
  283. {-# splitAt  :: Inline #-}
  284.  
  285. splitAtInt        :: Int -> [b] -> ([b],[b])
  286. splitAtInt  0     xs    =  ([],xs)
  287. splitAtInt  _     []    =  ([],[])
  288. splitAtInt (n+1) (x:xs)    =  (x:xs',xs'') where (xs',xs'') = splitAtInt n xs
  289. {-# splitAtInt  :: Inline #-}
  290.  
  291. -- takeWhile, applied to a predicate p and a list xs, returns the longest
  292. -- prefix (possibly empty) of xs of elements that satisfy p.  dropWhile p xs
  293. -- returns the remaining suffix.  Span p xs is equivalent to
  294. -- (takeWhile p xs, dropWhile p xs), while break p uses the negation of p.
  295.  
  296. takeWhile        :: (a -> Bool) -> [a] -> [a]
  297. takeWhile p l = build (\ c n -> foldr (\ a b -> if p a then c a b else n) n l)
  298. --takeWhile p []        =  []
  299. --takeWhile p (x:xs) 
  300. --            | p x       =  x : takeWhile p xs
  301. --            | otherwise =  []
  302. {-# takeWhile  :: Inline #-}
  303.  
  304.  
  305. dropWhile        :: (a -> Bool) -> [a] -> [a]
  306. dropWhile p []        =  []
  307. dropWhile p xs@(x:xs')
  308.         | p x       =  dropWhile p xs'
  309.         | otherwise =  xs
  310. {-# dropWhile  :: Inline #-}
  311.  
  312. span, break        :: (a -> Bool) -> [a] -> ([a],[a])
  313. span p []        =  ([],[])
  314. span p xs@(x:xs')
  315.        | p x    =  let (ys,zs) = span p xs' in (x:ys,zs)
  316.        | otherwise    =  ([],xs)
  317. break p            =  span (not . p)
  318.  
  319. {-# span  :: Inline #-}
  320. {-# break  :: Inline #-}
  321.  
  322.  
  323. -- lines breaks a string up into a list of strings at newline characters.
  324. -- The resulting strings do not contain newlines.  Similary, words
  325. -- breaks a string up into a list of words, which were delimited by
  326. -- white space.  unlines and unwords are the inverse operations.
  327. -- unlines joins lines with terminating newlines, and unwords joins
  328. -- words with separating spaces.
  329.  
  330. lines            :: String -> [String]
  331. lines ""        =  []
  332. lines s            =  let (l, s') = break (== '\n') s
  333.                in  l : case s' of
  334.                     []         -> []
  335.                     (_:s'') -> lines s''
  336.  
  337. words            :: String -> [String]
  338. words s            =  case dropWhile isSpace s of
  339.                 "" -> []
  340.                 s' -> w : words s''
  341.                       where (w, s'') = break isSpace s'
  342.  
  343. unlines            :: [String] -> String
  344. unlines            =  concat . map (++ "\n")
  345. {-# unlines  :: Inline #-}
  346.  
  347.  
  348. unwords            :: [String] -> String
  349. unwords []        =  ""
  350. unwords ws        =  foldr1 (\w s -> w ++ ' ':s) ws
  351.  
  352. -- nub (meaning "essence") removes duplicate elements from its list argument.
  353. nub            :: (Eq a) => [a] -> [a]
  354. nub l = build (\ c n ->
  355.                  let f x g [] = c x (g [x])
  356.              f x g xs = if elem x xs
  357.                            then (g xs)
  358.                    else c x (g (x:xs))
  359.                  in foldr f (\ _ -> n) l [])
  360. {-# nub  :: Inline #-}
  361. --nub []            =  []
  362. --nub (x:xs)        =  x : nub (filter (/= x) xs)
  363.  
  364. -- reverse xs returns the elements of xs in reverse order.  xs must be finite.
  365. reverse            :: [a] -> [a]
  366. reverse l = build (\ c n ->
  367.                      let f x g tail = g (c x tail)
  368.              in foldr f id l n)
  369. {-# reverse  :: Inline #-}
  370. --reverse x               =  reverse1 x [] where
  371. --  reverse1 [] a     = a
  372. --  reverse1 (x:xs) a = reverse1 xs (x:a)
  373.  
  374. -- and returns the conjunction of a Boolean list.  For the result to be
  375. -- True, the list must be finite; False, however, results from a False
  376. -- value at a finite index of a finite or infinite list.  or is the
  377. -- disjunctive dual of and.
  378. and, or            :: [Bool] -> Bool
  379. and            =  foldr (&&) True
  380. or            =  foldr (||) False
  381. {-# and :: Inline #-}
  382. {-# or  :: Inline #-}
  383.  
  384. -- Applied to a predicate and a list, any determines if any element
  385. -- of the list satisfies the predicate.  Similarly, for all.
  386. any, all        :: (a -> Bool) -> [a] -> Bool
  387. any p            =  or . map p
  388. all p            =  and . map p
  389. {-# any :: Inline #-}
  390. {-# all :: Inline #-}
  391.  
  392. -- elem is the list membership predicate, usually written in infix form,
  393. -- e.g., x `elem` xs.  notElem is the negation.
  394. elem, notElem        :: (Eq a) => a -> [a] -> Bool
  395.  
  396. elem x ys = foldr (\ y t -> (x == y) || t) False ys
  397. --x `elem` []        =  False
  398. --x `elem` (y:ys)         =  x == y || x `elem` ys
  399. {-# elem :: Inline #-}
  400. notElem    x y        =  not (x `elem` y)
  401.  
  402. -- sum and product compute the sum or product of a finite list of numbers.
  403. sum, product        :: (Num a) => [a] -> a
  404. sum            =  foldl (+) 0    
  405. product            =  foldl (*) 1
  406. {-# sum :: Inline #-}
  407. {-# product :: Inline #-}
  408.  
  409. -- sums and products give a list of running sums or products from
  410. -- a list of numbers.  For example,  sums [1,2,3] == [0,1,3,6].
  411. sums, products        :: (Num a) => [a] -> [a]
  412. sums            =  scanl (+) 0
  413. products        =  scanl (*) 1
  414.  
  415. -- maximum and minimum return the maximum or minimum value from a list,
  416. -- which must be non-empty, finite, and of an ordered type.
  417. maximum, minimum    :: (Ord a) => [a] -> a
  418. maximum            =  foldl1 max
  419. minimum            =  foldl1 min
  420. {-# maximum :: Inline #-}
  421. {-# minimum :: Inline #-}
  422.  
  423. -- concat, applied to a list of lists, returns their flattened concatenation.
  424. concat            :: [[a]] -> [a]
  425. concat xs    = build (\ c n -> foldr (\ x y -> foldr c y x) n xs)
  426. --concat []               =  []
  427. --concat (l:ls)           =  l ++ concat ls
  428. {-# concat :: Inline #-}
  429.  
  430.  
  431. -- transpose, applied to a list of lists, returns that list with the
  432. -- "rows" and "columns" interchanged.  The input need not be rectangular
  433. -- (a list of equal-length lists) to be completely transposable, but can
  434. -- be "triangular":  Each successive component list must be not longer
  435. -- than the previous one; any elements outside of the "triangular"
  436. -- transposable region are lost.  The input can be infinite in either
  437. -- dimension or both.
  438. transpose        :: [[a]] -> [[a]]
  439. transpose        =  foldr 
  440.                  (\xs xss -> zipWith (:) xs (xss ++ repeat []))
  441.                  []
  442. {-# transpose :: Inline #-}
  443.  
  444. -- zip takes two lists and returns a list of corresponding pairs.  If one
  445. -- input list is short, excess elements of the longer list are discarded.
  446. -- zip3 takes three lists and returns a list of triples, etc.  Versions
  447. -- of zip producing up to septuplets are defined here.
  448.  
  449. zip            :: [a] -> [b] -> [(a,b)]
  450. zip            =  zipWith (\a b -> (a,b))
  451. {-# zip :: Inline #-}
  452.  
  453. zip3            :: [a] -> [b] -> [c] -> [(a,b,c)]
  454. zip3            =  zipWith3 (\a b c -> (a,b,c))
  455. {-# zip3 :: Inline #-}
  456.  
  457. zip4            :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
  458. zip4            =  zipWith4 (\a b c d -> (a,b,c,d))
  459. {-# zip4 :: Inline #-}
  460.  
  461. zip5            :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
  462. zip5            =  zipWith5 (\a b c d e -> (a,b,c,d,e))
  463. {-# zip5 :: Inline #-}
  464.  
  465. zip6            :: [a] -> [b] -> [c] -> [d] -> [e] -> [f]
  466.                -> [(a,b,c,d,e,f)]
  467. zip6            =  zipWith6 (\a b c d e f -> (a,b,c,d,e,f))
  468. {-# zip6 :: Inline #-}
  469.  
  470. zip7            :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
  471.                -> [(a,b,c,d,e,f,g)]
  472. zip7            =  zipWith7 (\a b c d e f g -> (a,b,c,d,e,f,g))
  473. {-# zip7 :: Inline #-}
  474.  
  475. -- The zipWith family generalises the zip family by zipping with the
  476. -- function given as the first argument, instead of a tupling function.
  477. -- For example, zipWith (+) is applied to two lists to produce the list
  478. -- of corresponding sums.
  479.  
  480. zipWith            :: (a->b->c) -> [a]->[b]->[c]
  481. zipWith z as bs =
  482.   build (\ c' n' ->
  483.            let f' a g' (b:bs) = c' (z a b) (g' bs)
  484.            f' a g' _ = n'
  485.            in foldr f' (\ _ -> n') as bs)
  486. --zipWith z (a:as) (b:bs)    =  z a b : zipWith z as bs
  487. --zipWith _ _ _        =  []
  488. {-# zipWith :: Inline #-}
  489.  
  490. zipWith3        :: (a->b->c->d) -> [a]->[b]->[c]->[d]
  491. zipWith3 z as bs cs =
  492.   build (\ c' n' ->
  493.           let f' a g' (b:bs) (c:cs) = c' (z a b c) (g' bs cs)
  494.               f' a g' _ _ = n'
  495.           in foldr f' (\ _ _ -> n') as bs cs)
  496. {-# zipWith3 :: Inline #-}
  497. --zipWith3 z (a:as) (b:bs) (c:cs)
  498. --            =  z a b c : zipWith3 z as bs cs
  499. --zipWith3 _ _ _ _    =  []
  500.  
  501. zipWith4        :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
  502. zipWith4 z as bs cs ds =
  503.   build (\ c' n' ->
  504.           let f' a g' (b:bs) (c:cs) (d:ds) = c' (z a b c d) (g' bs cs ds)
  505.               f' a g' _ _ _ = n'
  506.           in foldr f' (\ _ _ _ -> n') as bs cs ds)
  507. {-# zipWith4 :: Inline #-}
  508. --zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)
  509. --            =  z a b c d : zipWith4 z as bs cs ds
  510. --zipWith4 _ _ _ _ _    =  []
  511.  
  512. zipWith5        :: (a->b->c->d->e->f)
  513.                -> [a]->[b]->[c]->[d]->[e]->[f]
  514. zipWith5 z as bs cs ds es=
  515.   build (\ c' n' ->
  516.           let f' a g' (b:bs) (c:cs) (d:ds) (e:es) =
  517.             c' (z a b c d e) (g' bs cs ds es)
  518.               f' a g' _ _ _ _ = n'
  519.           in foldr f' (\ _ _ _ _ -> n') as bs cs ds es)
  520. {-# zipWith5 :: Inline #-}
  521. --zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)
  522. --            =  z a b c d e : zipWith5 z as bs cs ds es
  523. --zipWith5 _ _ _ _ _ _    =  []
  524.  
  525. zipWith6        :: (a->b->c->d->e->f->g)
  526.                -> [a]->[b]->[c]->[d]->[e]->[f]->[g]
  527. zipWith6 z as bs cs ds es fs =
  528.   build (\ c' n' ->
  529.           let f' a g' (b:bs) (c:cs) (d:ds) (e:es) (f:fs) =
  530.             c' (z a b c d e f) (g' bs cs ds es fs)
  531.               f' a g' _ _ _ _ _ = n'
  532.           in foldr f' (\ _ _ _ _ _ -> n') as bs cs ds es fs)
  533. {-# zipWith6 :: Inline #-}
  534. --zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)
  535. --            =  z a b c d e f : zipWith6 z as bs cs ds es fs
  536. --zipWith6 _ _ _ _ _ _ _    =  []
  537.  
  538. zipWith7        :: (a->b->c->d->e->f->g->h)
  539.                -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]
  540. zipWith7 z as bs cs ds es fs gs =
  541.   build (\ c' n' ->
  542.           let f' a g' (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs) =
  543.             c' (z a b c d e f g) (g' bs cs ds es fs gs)
  544.               f' a g' _ _ _ _ _ _ = n'
  545.           in foldr f' (\ _ _ _ _ _ _ -> n') as bs cs ds es fs gs)
  546. {-# zipWith7 :: Inline #-}
  547. --zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)
  548. --           =  z a b c d e f g : zipWith7 z as bs cs ds es fs gs
  549. --zipWith7 _ _ _ _ _ _ _ _ =  []
  550.  
  551.  
  552. -- unzip transforms a list of pairs into a pair of lists.  As with zip,
  553. -- a family of such functions up to septuplets is provided.
  554.  
  555. unzip            :: [(a,b)] -> ([a],[b])
  556. unzip            =  foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[])
  557. {-# unzip :: Inline #-}
  558.  
  559.  
  560. unzip3            :: [(a,b,c)] -> ([a],[b],[c])
  561. unzip3            =  foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))
  562.                  ([],[],[])
  563. {-# unzip3 :: Inline #-}
  564.  
  565. unzip4            :: [(a,b,c,d)] -> ([a],[b],[c],[d])
  566. unzip4            =  foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->
  567.                     (a:as,b:bs,c:cs,d:ds))
  568.                  ([],[],[],[])
  569. {-# unzip4 :: Inline #-}
  570.  
  571. unzip5            :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])
  572. unzip5            =  foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->
  573.                     (a:as,b:bs,c:cs,d:ds,e:es))
  574.                  ([],[],[],[],[])
  575. {-# unzip5 :: Inline #-}
  576.  
  577. unzip6            :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])
  578. unzip6            =  foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->
  579.                     (a:as,b:bs,c:cs,d:ds,e:es,f:fs))
  580.                  ([],[],[],[],[],[])
  581. {-# unzip6 :: Inline #-}
  582.  
  583. unzip7            :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])
  584. unzip7            =  foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->
  585.                     (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))
  586.                  ([],[],[],[],[],[],[])
  587. {-# unzip7 :: Inline #-}
  588.  
  589. -- 1.3 Proposed Extensions
  590.  
  591. copy     :: Int -> a -> [a]
  592. copy  n x = take n (repeat x)
  593.  
  594. lookup :: Eq a => [(a,b)] -> a -> Maybe b
  595. lookup [] _ = Nothing
  596. lookup ((key,val) : rest) x | key == x = Just val
  597.                             | otherwise = lookup rest x
  598.